Timeline Visualization

library(scales)
library(lubridate)

## 
## Attaching package: 'lubridate'

## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

library(ggplot2)
library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr   1.1.4     ✔ stringr 1.5.1
## ✔ forcats 1.0.0     ✔ tibble  3.2.1
## ✔ purrr   1.0.2     ✔ tidyr   1.3.0
## ✔ readr   2.1.5

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ readr::col_factor() masks scales::col_factor()
## ✖ purrr::discard()    masks scales::discard()
## ✖ dplyr::filter()     masks stats::filter()
## ✖ dplyr::lag()        masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(knitr)

## Warning: package 'knitr' was built under R version 4.3.3

library(timevis)

Merkel <- data.frame(
  Year = c(rep(c(2018), times =12), rep(c(2019), times =2)), 
  Months = c(1,2,2,3,6,9,9,10,11,11,12,12,1,3), 
  Days = c(1,2,15,2,2,8,29,20,10,27,1,23,15,10),
  Milestones = c("Diagnosed with MCC", "PET-CT (No evidence of metastatic disease)", "WLE and SLNBx", "PET-CT (No evidence of disease)", "PET-CT (No evidence of disease)", "PET-CT (Concerning for Recurrence)", "Cycle 1", "Cycle 2", "Cycle 3","PET-CT (Partial Response)","Cycle 4", "Cycle 5",  "Cycle 6","PET-CT (Complete Response)"), 
  Event_type= c("Biopsy", "Imaging", "Surgery", "Imaging", "Imaging", "Imaging", "Immunotherapy", "Immunotherapy","Immunotherapy","Imaging","Immunotherapy", "Immunotherapy", "Immunotherapy", "Imaging")) #The data set was created with the year, month and day in separate columns. Let's add the complete date column now

Merkel$date <- with(Merkel, ymd(sprintf('%04d%02d%02d', Merkel$Year, Merkel$Months, Merkel$Days))) 
# of note, the ymd() function transforms dates stored in character and numeric vectors to Date
## we are using the code with(df, ymd(sprintf('%04d%02d%02d', year, mon, day))) to take those three columns and merge them into one that is recognized as a date in R

Merkel <- Merkel[with(Merkel, order(date)), ]
# of note, an alternate code to arrange the df in ascending date order would have been: 
## Merkel <- Merkel %>% arrange(date)

kable(head(Merkel))

Year	Months	Days	Milestones	Event_type	date
2018	1	1	Diagnosed with MCC	Biopsy	2018-01-01
2018	2	2	PET-CT (No evidence of metastatic disease)	Imaging	2018-02-02
2018	2	15	WLE and SLNBx	Surgery	2018-02-15
2018	3	2	PET-CT (No evidence of disease)	Imaging	2018-03-02
2018	6	2	PET-CT (No evidence of disease)	Imaging	2018-06-02
2018	9	8	PET-CT (Concerning for Recurrence)	Imaging	2018-09-08

# Add a specified order to these event type labeles
Event_type_levels <- c("Biopsy", "Surgery", "Imaging", "Immunotherapy") 

# Define the colors for the event types in the specified order. 
## These hashtagged codes represent the colors (blue, green, yellow, red) as hexadecimal color codes.
Event_type_colors <- c("#C00000", "#FFC000",  "#00B050", "#0070C0" ) 


# Make the Event_type vector a factor using the levels we defined above
Merkel$Event_type <- factor(Merkel$Event_type, levels= Event_type_levels, ordered=TRUE)

# Set the heights we will use for our milestones.
positions <- c(0.5, -0.5, 1.0, -1.0, 1.25, -1.25, 1.5, -1.5) 

# Set the directions we will use for our milestone, for example above and below.
directions <- c(1, -1) 


# Assign the positions & directions to each date from those set above.
line_pos <- data.frame(
    "date"=unique(Merkel$date),
    "position"=rep(positions, length.out=length(unique(Merkel$date))),
    "direction"=rep(directions, length.out=length(unique(Merkel$date))))

# Create columns with the specified positions and directions for each milestone event
Merkel <- merge(x=Merkel, y=line_pos, by="date", all = TRUE) 

# Let's view the new columns.
kable(head(Merkel))

date	Year	Months	Days	Milestones	Event_type	position	direction
2018-01-01	2018	1	1	Diagnosed with MCC	Biopsy	0.50	1
2018-02-02	2018	2	2	PET-CT (No evidence of metastatic disease)	Imaging	-0.50	-1
2018-02-15	2018	2	15	WLE and SLNBx	Surgery	1.00	1
2018-03-02	2018	3	2	PET-CT (No evidence of disease)	Imaging	-1.00	-1
2018-06-02	2018	6	2	PET-CT (No evidence of disease)	Imaging	1.25	1
2018-09-08	2018	9	8	PET-CT (Concerning for Recurrence)	Imaging	-1.25	-1

# Create a one month "buffer" at the start and end of the timeline
month_buffer <- 1 

month_date_range <- seq(min(Merkel$date) - months(month_buffer), max(Merkel$date) + months(month_buffer), by='month')


# We are adding one month before and one month after the earliest and latest milestone in the clinical course.
## We want the format of the months to be in the 3 letter abbreviations of each month.
month_format <- format(month_date_range, '%b') 
month_df <- data.frame(month_date_range, month_format)


year_date_range <- seq(min(Merkel$date) - months(month_buffer), max(Merkel$date) + months(month_buffer), by='year')

# We will only show the years for which we have a december to january transition.
year_date_range <- as.Date(
    intersect(
        ceiling_date(year_date_range, unit="year"),
        floor_date(year_date_range, unit="year")),  
        origin = "1970-01-01") 

# We want the format to be in the four digit format for years.
year_format <- format(year_date_range, '%Y') 
year_df <- data.frame(year_date_range, year_format)

# Create timeline coordinates with an x and y axis
timeline_plot<-ggplot(Merkel,aes(x=date,y= position, col=Event_type, label=Merkel$Milestones)) 

# Add the label Milestones
timeline_plot<-timeline_plot+labs(col="Milestones") 

# Print plot
timeline_plot

## Warning: Use of `Merkel$Milestones` is discouraged.
## ℹ Use `Milestones` instead.

# Assigning the colors and order to the milestones
timeline_plot<-timeline_plot+scale_color_manual(values=Event_type_colors, labels=Event_type_levels, drop = FALSE) 

# Using the classic theme to remove background gray
timeline_plot<-timeline_plot+theme_classic() 

# Plot a horizontal line at y=0 for the timeline
timeline_plot<-timeline_plot+geom_hline(yintercept=0, 
                color = "black", size=0.3)

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

# Print plot
timeline_plot

# Plot the vertical lines for our timeline's milestone events
timeline_plot<-timeline_plot+geom_segment(data=Merkel, aes(y=Merkel$position,yend=0,xend=Merkel$date), color='black', size=0.2) 


# Now let's plot the scatter points at the tips of the vertical lines and date
timeline_plot<-timeline_plot+geom_point(aes(y=Merkel$position), size=3) 

# Let's remove the axis since this is a horizontal timeline and postion the legend to the bottom
timeline_plot<-timeline_plot+theme(axis.line.y=element_blank(),
                 axis.text.y=element_blank(),
                 axis.title.x=element_blank(),
                 axis.title.y=element_blank(),
                 axis.ticks.y=element_blank(),
                 axis.text.x =element_blank(),
                 axis.ticks.x =element_blank(),
                 axis.line.x =element_blank(),
                 legend.position = "bottom"
                ) 
# Print plot
timeline_plot

## Warning: Use of `Merkel$position` is discouraged.
## ℹ Use `position` instead.

## Warning: Use of `Merkel$date` is discouraged.
## ℹ Use `date` instead.

## Warning: Use of `Merkel$Milestones` is discouraged.
## ℹ Use `Milestones` instead.

## Warning: Use of `Merkel$position` is discouraged.
## ℹ Use `position` instead.

## Warning: Use of `Merkel$Milestones` is discouraged.
## ℹ Use `Milestones` instead.

# Let's add the text for each month
timeline_plot<-timeline_plot+geom_text(data=month_df, aes(x=month_date_range,y=-0.15,label=month_format),size=3.5,vjust=0.5, color='black', angle=90) 


# Let's add the years
timeline_plot<-timeline_plot+geom_text(data=year_df, aes(x=year_date_range,y=-0.25,label=year_format, fontface="bold"),size=3.5, color='black') 

# Print plot
print(timeline_plot)

## Warning: Use of `Merkel$position` is discouraged.
## ℹ Use `position` instead.

## Warning: Use of `Merkel$date` is discouraged.
## ℹ Use `date` instead.

## Warning: Use of `Merkel$Milestones` is discouraged.
## ℹ Use `Milestones` instead.

## Warning: Use of `Merkel$position` is discouraged.
## ℹ Use `position` instead.

## Warning: Use of `Merkel$Milestones` is discouraged.
## ℹ Use `Milestones` instead.

# We need to add the labels of each milestone now. 
## To do this we have to define the text position. A clean timeline should have the labels situatuated a bit above the scatter points.
### Since we have the positions of the points already defined, we will place the labels 0.2 pts away from the scatter points.


# Lets offset the labels 0.2 away from scatter points
text_offset <- 0.2 

# Let's use the absolute value since we want to add the text_offset and increase space away from the scatter points 
absolute_value<-(abs(Merkel$position)) 
text_position<- absolute_value + text_offset

# Let's keep the direction above or below for the labels to match the scatter points
Merkel$text_position<- text_position * Merkel$direction 

# View head of the table
kable(head(Merkel))

date	Year	Months	Days	Milestones	Event_type	position	direction	text_position
2018-01-01	2018	1	1	Diagnosed with MCC	Biopsy	0.50	1	0.70
2018-02-02	2018	2	2	PET-CT (No evidence of metastatic disease)	Imaging	-0.50	-1	-0.70
2018-02-15	2018	2	15	WLE and SLNBx	Surgery	1.00	1	1.20
2018-03-02	2018	3	2	PET-CT (No evidence of disease)	Imaging	-1.00	-1	-1.20
2018-06-02	2018	6	2	PET-CT (No evidence of disease)	Imaging	1.25	1	1.45
2018-09-08	2018	9	8	PET-CT (Concerning for Recurrence)	Imaging	-1.25	-1	-1.45

# Now we can add the labels to the timeline for our milestones.
timeline_plot<-timeline_plot+geom_text(aes(y=Merkel$text_position,label=Merkel$Milestones),size=3.5, vjust=0.6)

# Print plot
print(timeline_plot)

# Now we can add the labels to the timeline for our milestones.
timeline_plot<-timeline_plot+geom_text(aes(y=Merkel$text_position,label=Merkel$Milestones),size=3.5, vjust=0.6)

# Print plot
print(timeline_plot)

library(plotly)

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

ggplotly(timeline_plot)

# Let's prepare our data so that it is compatible with quick visualization in timevis
## Each milestone will need a start date added. If it is a duration, we will also supply the end date


# Let's remove Cycles 2,3,4,5 and 6 since we will just show the patient's duration on systemic therapy and not the individual cycle dates
MCC<-  Merkel[-c(8,9,11:13),] 


# The start date for each milestone is the date of the event. 
## If it was a single date event and not a duration, it will not have an end date.
MCC$start <-MCC$date 


# The end date will be "NA" if the event had no duration. 
## Only systemic therapy will have an end date which will be the date of cycle 6.
MCC$end<-c(NA, NA, NA, NA, NA, NA,"2019-01-15", NA, NA) 

#Let's replace the label "Cycle 1" with "Checkpoint Inhibitor- Systemic Therapy" using library stringr
library(stringr)

MCC$Milestones<-str_replace_all(MCC$Milestones, "Cycle 1", "Checkpoint Inhibitor- Systemic Therapy")

# Each milestone will need an ID for visualization and content for labels.
MCC$id<- 1:9
MCC$content<- MCC$Milestones
kable(head(MCC))

date	Year	Months	Days	Milestones	Event_type	position	direction	text_position	start	end	id	content
2018-01-01	2018	1	1	Diagnosed with MCC	Biopsy	0.50	1	0.70	2018-01-01	NA	1	Diagnosed with MCC
2018-02-02	2018	2	2	PET-CT (No evidence of metastatic disease)	Imaging	-0.50	-1	-0.70	2018-02-02	NA	2	PET-CT (No evidence of metastatic disease)
2018-02-15	2018	2	15	WLE and SLNBx	Surgery	1.00	1	1.20	2018-02-15	NA	3	WLE and SLNBx
2018-03-02	2018	3	2	PET-CT (No evidence of disease)	Imaging	-1.00	-1	-1.20	2018-03-02	NA	4	PET-CT (No evidence of disease)
2018-06-02	2018	6	2	PET-CT (No evidence of disease)	Imaging	1.25	1	1.45	2018-06-02	NA	5	PET-CT (No evidence of disease)
2018-09-08	2018	9	8	PET-CT (Concerning for Recurrence)	Imaging	-1.25	-1	-1.45	2018-09-08	NA	6	PET-CT (Concerning for Recurrence)

timevis(MCC)